00100		TITLE	CHECK	CHECK SUM A USER'S DISK AREA.
00200		SUBTTL	R.E. GORIN 24 OCTOBER 71
00300	
00400	IFDEF FOR,<MACRO←←0;>MACRO==1		;PROCESSOR SELECTOR
00500	
00600
00700	
00800
00900	IFE MACRO,<
01000		DEFINE DEF(A,B)<
01100		A←B>
01200		DEFINE SDEF(A,B)<
01300		A←←B>
01400	>
01500	IFG MACRO,<
01600		DEFINE DEF(A,B)<
01700		A=B>
01800		DEFINE SDEF(A,B)<
01900		A==B>
02000	>
02100	
02200		EXTERN	JOBFF,JOBREL
02300	
02400	OPDEF	RESET	[CALLI]
02500	OPDEF	SWAP	[CALLI	400004]
02600	OPDEF	EXIT	[CALLI	12]
02700	OPDEF	GETPPN	[CALLI	24]
02800	OPDEF	CORE	[CALLI	11]
02900	OPDEF	TTCALL	[51B8]
03000	OPDEF	OUTCHR	[TTCALL	1,]
03100	OPDEF	OUTSTR	[TTCALL 3,]
03200	
03300	SDEF(PDLEN,50)		;SIZE OF PUSH-DOWN LIST
03400	SDEF(DSK,15)
03500	SDEF(RPG,17)
03600	SDEF(FILE,14)
03700	
03800	
03900		DEF(FL,0)		;THE ACCUMULATOR DEFINITIONS
04000		DEF(A,1)
04100		DEF(B,2)
04200		DEF(C,3)
04300		DEF(D,4)
04400		DEF(W,5)
04500		DEF(X,6)
04600		DEF(Y,7)
04700		DEF(Z,10)
04800		DEF(K,11)
04900		DEF(L,12)
05000		DEF(M,13)
05100		DEF(N,14)
05200		DEF(P,17)
05300	
     

00100		SUBTTL	DATA STORAGE FOR CHECK
00200	DSKBUF:	BLOCK	3
00300	SAVEPD:	0			;TEMP STORE FOR PDL POINTER
00400	CIBUF:	BLOCK	3		;BUFFER HEADS FOR CHECKSUM
00500	COBUF:	BLOCK	3		;BUFFER HEADS FOR CHECKSUM
00600	CLEN:	0			;
00700	FIBUF:	BLOCK	3
00800	FLEN:	0
00900	UFDLEN:	0
01000	FPTR:	0
01100	FLOC:	0
01200	FILBUF:	BLOCK	9*205
01300	CHKIBF:
01400	CHKOBF:	BLOCK	2*205
01500	LBLOCK:	BLOCK	4
01600	PDLIST:	BLOCK	PDLEN	;PUSH DOWN LIST
01700	USER:	0
01800	RPGSW:	0
01900	GOD:	'  1  1'
02000	ACSAVE:	BLOCK	20
     

00100		SUBTTL	ALARUMS AND DIVERSIONS
00200	NODISK:	OUTSTR	[ASCIZ/
00300	CAN'T INIT THE DISK!
00400	/]
00500		JRST	CHKXIT
00600	NOCORE:	OUTSTR	[ASCIZ/
00700	CORE UUO HAS FAILED!
00800	/]
00900		JRST	CHKXIT
01000	NOUFD:	OUTSTR	[ASCIZ/
01100	I CAN'T FIND THE UFD!
01200	/]
01300		JRST	CHKXIT
01400	UFDERR:	OUTSTR	[ASCIZ/
01500	UNEXPECTED EOF WHILE READDING UFD!
01600	/]
01700		JRST	CHKXIT		;EXIT FROM CHECKSUM KLUGE
01800	DDEX:	OUTSTR	[ASCIZ/DATA ERROR ON INPUT FILE
01900	/]
02000		JRST	CHKXIT
02100	CKENTF:	OUTSTR	[ASCIZ/
02200	CAN'T ENTER CHECKSUM FILE!
02300	/]
02400		JRST	CHKXIT
     

00100		subttl	File checksum routine to test for garbaged files. J.A.M
00200	chkxit:	move	p,savepd		;restore stack pointer
00300		popj	p,			;return
00400	CHECK:	movem	p,savepd		;save stack pointer
00500		OUTSTR	[asciz/Checksum being computed...
00600	/]
00700		move	a,user			;get users name
00800		movem	a,lblock		;save for UFD
00900		movsi	a,'UFD'			;lookup
01000		movem	a,lblock+1		;...
01100		setzm	lblock+2		;...
01200		move	a,GOD			;god's name
01300		movem	a,lblock+3		;stuff in lookup block
01400		init	dsk,210			;init the disk
01500		sixbit	/DSK/			;for the ufd
01600		xwd	0,dskbuf
01700		jrst	nodisk
01800		inbuf	dsk,2			;make buffers
01900		lookup	dsk,lblock		;lookup the ufd
02000		jrst	noufd			;this can't happen
02100		movs	a,lblock+3		;get - word count
02200		movem	a,ufdlen		;save here
02300		move	a,[sixbit /CKSUM/]	;make lookup block for checksum
02400		movem	a,lblock		;
02500		movsi	a,'DAT'
02600		movem	a,lblock+1
02700		setzm	lblock+2
02800		move	a,user
02900		movem	a,lblock+3
03000		init	rpg,210			;open channel for checksum file io
03100		sixbit	/DSK/
03200		xwd	cobuf,cibuf
03300		jrst	nodisk
03400		hrrz	a,jobff
03500		movem	a,fptr
03600		movem	a,floc
03700		lookup	rpg,lblock
03800		jrst	nockf
03900		movs	a,lblock+3
04000		movem	a,z
04100		movem	a,clen
04200		movei	a,chkibf
04300		exch	a,jobff
04400		inbuf	rpg,2
04500		exch	a,jobff
04600	s3:	pushj	p,cget
04700		jrst	[hrrz	a,floc
04800			setzm	b
04900	s5:		skipn	(a)
05000			jrst	[came	b,1(a)
05100				jrst	ckerr
05200				movem	a,fptr
05300				jrst	nockf]
05400			jumpg	z,ckerr
05500			add	b,(a)
05600			add	b,1(a)
05700			add	b,2(a)
05800			add	b,3(a)
05900			add	b,4(a)
06000			addi	a,5
06100			addi	z,5
06200			jrst	s5]
06300		movem	a,@fptr
06400		aos	a,fptr
06500		hrrz	b,jobrel
06600		camg	a,b
06700		jrst	s3
06800		addi	b,2000
06900		core	b,
07000		jrst	ckerr
07100		jrst	s3
07200	
07300	ckerr:	hrrz	a,floc
07400		movem	a,fptr
07500	nockf:	pushj	p,rdufd
07600		jrst	xdone
07700		movem	a,lblock
07800		pushj	p,rdufd
07900		jrst	ufderr
08000		hllzm	a,lblock+1
08100		pushj	p,rdufd
08200		jrst	ufderr
08300		pushj	p,rdufd
08400		jrst	ufderr
08500		setzm	lblock+2
08600		move	a,user
08700		movem	a,lblock+3
08800		move	a,lblock
08900		hllz	b,lblock+1
09000		camn	a,[sixbit /CKSUM/]
09100		came	b,[sixbit /DAT   /]
09200		jumpn	a,s9
09300		jrst	nockf
09400	
09500	s9:	init	file,210
09600		sixbit	/DSK/
09700		xwd	fibuf,fibuf
09800		jrst	nodisk
09900		lookup	file,lblock
10000		jrst	[hrrz	a,lblock
10100			cain	a,10
10200			jrst	s7
10300			jrst	nockf]
10400		movs	a,lblock+3
10500		movem	a,flen
10600		movei	a,filbuf
10700		exch	a,jobff
10800		inbuf	file,9
10900		movem	a,jobff
11000		setzm	b
11100	cloop:	pushj	p,fget
11200		jrst	cdone
11300		addm	a,b
11400		jrst	cloop
11500	
11600	s7:	close	file,
11700		setzm	lblock+2
11800		move	a,user
11900		movem	a,lblock+3
12000		hllzs	lblock+1
12100		enter	file,lblock
12200		jrst	nockf
12300		setzm	lblock
12400		rename	file,lblock
12500		jrst	nockf
12600		releas	file,
12700		jrst	nockf
12800	
12900	cdone:	hrrz	a,floc
13000		move	c,lblock
13100		hllz	d,lblock+1
13200		move	x,lblock+1
13300		move	y,lblock+2
13400		move	z,lblock+3
13500	ckl:	caml	a,fptr
13600		jrst	cknf
13700		came	c,(a)
13800		jrst	[
13900	ckc:		addi	a,5
14000			jrst	ckl]
14100		hllz	w,1(a)
14200		came	d,w
14300		jrst	ckc
14400		camn	x,1(a)
14500		came	y,2(a)
14600		jrst	update
14700		came	z,3(a)
14800		jrst	update
14900		camn	b,4(a)
15000		jrst	nockf
15100		outstr	[asciz/
15200	ππ ππ	checksum failure: /]
15300		pushj	p,tfn
15400		jrst	nockf
15500	
15600	cknf:	hrrz	a,jobrel
15700		subi	a,6
15800		camle	a,fptr
15900		jrst	cknf1
16000		hrrz	a,jobrel
16100		addi	a,2000
16200		core	a,
16300		jrst	nocore
16400	cknf1:	move	a,fptr
16500		movem	c,(a)
16600		movem	x,1(a)
16700		movem	y,2(a)
16800		movem	z,3(a)
16900		movem	b,4(a)
17000		addi	a,5
17100		movem	a,fptr
17200		jrst	nockf
17300	
17400	update:	movem	x,1(a)
17500		movem	y,2(a)
17600		movem	z,3(a)
17700		movem	b,4(a)
17800		addi	a,5
17900		jrst	nockf
18000	
18100	xdone:	move	a,[sixbit /CKSUM/]
18200		movem	a,lblock
18300		movsi	a,'DAT'
18400		movem	a,lblock+1
18500		setzm	lblock+2
18600		move	a,user
18700		movem	a,lblock+3
18800		enter	rpg,lblock
18900		jrst	ckentf			;checksum file enter failed
19000	
19100	
19200		movei	a,chkobf
19300		exch	a,jobff
19400		outbuf	rpg,2
19500		exch	a,jobff
19600		hrrz	c,floc
19700		setzm	b
19800	s8:	caml	c,fptr
19900		jrst	[setzm	a
20000			pushj	p,cput
20100			move	a,b
20200			pushj	p,cput
20300			close	rpg,
20400			releas	rpg,
20500			jrst	chkxit]
20600		add	b,(c)
20700		move	a,(c)
20800		pushj	p,cput
20900		aoja	c,s8
21000	
21100	
21200	; IO routines
21300	
21400	
21500	
21600	cget:	aosle	clen
21700		popj	p,
21800		sosg	cibuf+2
21900		in	rpg,
22000		jrst	[ildb	a,cibuf+1
22100			jrst	cpopj1]
22200	
22300		jrst	ddex
22400	
22500	fget:	aosle	flen
22600		popj	p,
22700		sosg	fibuf+2
22800		in	file,
22900		jrst	[ildb	a,fibuf+1
23000			jrst	cpopj1]
23100	
23200		OUTSTR	[asciz/Data error in file:  /]
23300		pushj	p,tfn
23400		popj	p,
23500	
23600	CPOPJ1:	AOS	(P)
23700		POPJ	P,
23800	cput:	sosg	cobuf+2
23900		out	rpg,
24000		jrst	[idpb	a,cobuf+1
24100			popj	p,]
24200		OUTSTR	[asciz/Checksum file output error
24300	/]
24400		jrst	chkxit
24500	
24600	tfn:	move	a,[point 6,lblock]
24700		movei	b,6
24800	tfn1:	ildb	c,a
24900		jumpe	c,tfn2
25000		addi	c,"A"-'A'
25100		OUTCHR	c
25200	tfn2:	sojg	b,tfn1
25300		hllz	c,lblock+1
25400		jumpe	c,tfn3
25500		OUTSTR	[asciz ⊗.⊗]
25600		movei	b,3
25700	tfn4:	ildb	c,a
25800		jumpe	c,tfn5
25900		addi	c,"A"-'A'
26000		OUTCHR	c
26100	tfn5:	sojg	b,tfn4
26200	tfn3:	OUTSTR	[asciz ⊗
26300	⊗]
26400		popj	p,
26500	rdufd:	aosle	ufdlen
26600		popj	p,
26700		sosle	dskbuf+2
26800		jrst	rdufd1
26900		input	dsk,
27000		statz	dsk,740000
27100		jrst	ufddde
27200		statz	dsk,20000
27300		popj	p,
27400	rdufd1:	ildb	a,dskbuf+1
27500		jrst	cpopj1
27600	ufddde:	OUTSTR	[asciz/UFD input error.
27700	/]
27800		popj	p,
     

00100		SUBTTL	INITIALIZATION
00200	BEGIN:	TDZA	FL,FL
00300		SETO	FL,
00400		MOVEM	FL,RPGSW
00500		SKIPE	RPGSW
00600		JRST	SETRPG
00700		SETZ	A,
00800		GETPPN	A,
00900		JFCL
01000		MOVEM	A,USER
01100		RESET
01200		MOVE	P,[IOWD PDLEN,PDLIST]
01300		PUSHJ	P,CHECK
01400		EXIT
01500	SETRPG:	MOVEM	A,USER
01600		MOVE	A,[XWD 2,ACSAVE]
01700		BLT	A,ACSAVE+15		;SAVE SOME AC'S
01800		RESET
01900		MOVE	P,[IOWD PDLEN,PDLIST]
02000		PUSHJ	P,CHECK
02100		MOVE	A,[XWD ACSAVE,2]
02200		BLT	A,17
02300		CAME	B,['LOGRUN']		;DO WE HAVE A PROGRAM TO RUN?
02400		EXIT				;NO
02500		MOVEI	A,RUNBLK
02600		SWAP	A,
02700		EXIT
02800	RUNBLK:	'SYS   '
02900		'LOGRUN'
03000		'DMP   '
03100		0
03200		0
03300		END 	BEGIN